Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/favori/favorit1.frm

Visual Basic Form | 1995-05-08 | 17.4 KB | 492 lines

VERSION 2.00
Begin Form Form1
   BackColor       =   &H0080C0FF&
   Caption         =   "Favorite Program Launcher"
   ClientHeight    =   3990
   ClientLeft      =   375
   ClientTop       =   2085
   ClientWidth     =   7845
   FontBold        =   -1  'True
   FontItalic      =   0   'False
   FontName        =   "Courier"
   FontSize        =   9.75
   FontStrikethru  =   0   'False
   FontUnderline   =   0   'False
   ForeColor       =   &H00000000&
   Height          =   4680
   Icon            =   FAVORIT1.FRX:0000
   Left            =   315
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   ScaleHeight     =   3990
   ScaleWidth      =   7845
   Top             =   1455
   Width           =   7965
   Begin CommandButton DosButton
      Caption         =   "Shell to DOS"
      Height          =   375
      Left            =   240
      TabIndex        =   2
      Top             =   3240
      Width           =   2895
   End
   Begin CommandButton CancelButton
      Caption         =   "Cancel"
      Height          =   495
      Left            =   6720
      TabIndex        =   7
      Top             =   3120
      Visible         =   0   'False
      Width           =   855
   End
   Begin CommandButton OKButton
      Caption         =   "OK"
      Height          =   495
      Left            =   5280
      TabIndex        =   6
      Top             =   3120
      Visible         =   0   'False
      Width           =   855
   End
   Begin CheckBox Check1
      BackColor       =   &H0080C0FF&
      Caption         =   "Check1"
      Height          =   255
      Left            =   720
      TabIndex        =   1
      Top             =   3000
      Width           =   255
   End
   Begin TextBox CommandlineName
      BackColor       =   &H00E0FFFF&
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   9.75
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   375
      Left            =   5280
      TabIndex        =   5
      Top             =   2040
      Visible         =   0   'False
      Width           =   2295
   End
   Begin CommandButton BrowseButton
      BackColor       =   &H00C0C0C0&
      Caption         =   "Pick A File"
      Height          =   495
      Left            =   6000
      TabIndex        =   4
      Top             =   960
      Width           =   1095
   End
   Begin ListBox List1
      BackColor       =   &H00E0FFFF&
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   12
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   2130
      Left            =   600
      Sorted          =   -1  'True
      TabIndex        =   0
      Top             =   720
      Width           =   2295
   End
   Begin TextBox PetName
      BackColor       =   &H00E0FFFF&
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   12
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   420
      Left            =   5400
      TabIndex        =   3
      Top             =   240
      Visible         =   0   'False
      Width           =   1935
   End
   Begin PictureBox Picture1
      Height          =   495
      Left            =   1560
      Picture         =   FAVORIT1.FRX:0302
      ScaleHeight     =   465
      ScaleWidth      =   465
      TabIndex        =   11
      Top             =   120
      Width           =   495
   End
   Begin Label Checklabel
      BackColor       =   &H0080C0FF&
      Caption         =   "Minimize on Launch"
      Height          =   255
      Left            =   1080
      TabIndex        =   8
      Top             =   3000
      Width           =   1815
   End
   Begin Label CommandlineLabel
      BackColor       =   &H0080C0FF&
      Caption         =   "Command Line"
      Height          =   255
      Left            =   3960
      TabIndex        =   10
      Top             =   2160
      Visible         =   0   'False
      Width           =   1455
   End
   Begin Label Filenamelabel
      BackColor       =   &H00C0E0FF&
      BorderStyle     =   1  'Fixed Single
      Height          =   255
      Left            =   4560
      TabIndex        =   12
      Top             =   1560
      Width           =   3255
   End
   Begin Label PetnameLabel
      Alignment       =   2  'Center
      BackColor       =   &H0080C0FF&
      Caption         =   "Pet Name"
      Height          =   255
      Left            =   4080
      TabIndex        =   9
      Top             =   480
      Visible         =   0   'False
      Width           =   1095
   End
   Begin Menu AddMenu
      Caption         =   "&Add"
   End
   Begin Menu ChangeMenu
      Caption         =   "&Change"
   End
   Begin Menu DeleteMenu
      Caption         =   "&Delete"
   End
   Begin Menu UndeleteMenu
      Caption         =   "&Undelete"
   End
   Begin Menu HelpMenu
      Caption         =   "&Help"
      Begin Menu HelpKey
         Shortcut        =   {F1}
         Visible         =   0   'False
      End
   End
   Begin Menu AboutMenu
      Caption         =   "&About"
   End
'GLOBALS TO FORM
Dim MAINTSWITCH As String       'tells if "A"dd or "C"hange
Dim TRUEFALSE As Integer        'used in subrte to swap visibility
Dim FIRSTSWITCH As String       'used at load time for initialization
Dim INIDATA As String           'work area
Dim DELETEDITEMS(100)  As String  'array saves prior deletes
                                  '  for UNDELETE menu item
' display the "About" menu (Form3) when menu item clicked
Sub AboutMenu_Click ()
 Load Form3                  'load the form
 Form3.visible = True        'make it visible
 Form3.COMMAND1.SetFocus     'change focus to forms "OK" button
End Sub
'adds and changes to list of programs and FAVORITE.INI file
'are processed here
Sub add_to_list ()
 If MAINTSWITCH = "C" Then     'came here by "C"hange
  WORKITEM% = List1.listindex  'find item in list1 array
 End If
 If LTrim$(RTrim$(Petname.text)) = "" Then
    Beep                     'user didn't enter PETNAME
    response% = MsgBox("Enter information in Pet Name or Cancel your change.", 64, "Message")
    Petname.SetFocus         'put cursor back at PETNAME
    Exit Sub
 ElseIf LTrim$(RTrim$(RUNFILENAME$)) = "" Then
    Beep                      'user didn't enter PROGRAMNAME
    response% = MsgBox("Enter program name information or Cancel the change.", 64, "Message")
    Commandlinename.SetFocus  'put cursor back at PROGRAMNAME
    Exit Sub
 End If
 WORK% = Len(Petname.text)    'align the entered data so it
 If WORK% >= 20 Then          'can be placed in list1 and .INI file
    DATAWORK$ = UCase$(Left$(Petname.text, 20))
 Else
    DATAWORK$ = UCase$(Petname.text + String$(20 - WORK%, " "))
 End If
 WORK% = Len(RUNFILENAME$)
    DATAWORK$ = DATAWORK$ + String$(10, " ") + RUNFILENAME$ + String$(50 - WORK%, " ")
 WORK% = Len(Commandlinename.text) 'align COMMANDLINE
 If WORK% >= 32 Then
     DATAWORK$ = DATAWORK$ + Left$(Commandlinename.text, 32)
 Else
     DATAWORK$ = DATAWORK$ + Commandlinename.text + String$(32 - WORK%, " ")
 End If
 If MAINTSWITCH = "C" Then     'if change, remove old item from List1
     List1.RemoveItem WORKITEM%
 End If
MAINTSWITCH = ""          'not needed any further, clear
List1.AddItem DATAWORK$   'add to list1
Writefile                 'go to subrte to write FAVORITE.INI file
Make_Boxes_Visible (False) 'hide the right side boxes & buttons
Clear_the_fields          'clear the box texts
End Sub
Sub AddCtl_Click ()
 List1.visible = True        'make right side of form visible
 Make_Boxes_Visible (True)
End Sub
' invoked when "Add" is clicked
Sub AddMenu_Click ()
 Clear_the_fields
 Make_Boxes_Visible (True)     'sub to make right side of form
 MAINTSWITCH = "A"             'visible
 Petname.SetFocus              'move cursor to PETNAME field
 End Sub
Sub BrowseButton_Click ()
 Load form4
 form4.visible = True
End Sub
' user CANCELS a change or ADD transaction
Sub CancelButton_Click ()
 Clear_the_fields             'clear any entered data
 Make_Boxes_Visible (False)     'sub to shrink form
End Sub
' invoked when user selects CHANGE from menu
Sub ChangeMenu_Click ()
If List1.listcount < 1 Or List1.listindex < 0 Then
  Beep               'nothing in list1 array to change
  If List1.listcount > 0 Then   'tell them what to do
    response% = MsgBox("Click an item in the list first.", 64, "Message")
  Else
    response% = MsgBox("No items in list.", 64, "Message")
  End If
  Exit Sub
End If
 Make_Boxes_Visible (True)     'make form wide
 MAINTSWITCH = "C"             'tell the world we are doing a
                               'change transaction
'move data from item in List1 array to text boxes
Petname.text = Left$(List1.list(List1.listindex), 20)
RUNFILENAME$ = Mid$(List1.list(List1.listindex), 31, 50)
Filenamelabel.caption = RUNFILENAME$ + String$(50, " ")
Commandlinename.text = Right$(List1.list(List1.listindex), 32)
Petname.SetFocus       'move cursor to PETNAME field
End Sub
Sub Clear_the_fields ()
 Petname.text = ""             'clear text box data
 Filenamelabel.caption = ""    'clear the current file name
 RUNFILENAME$ = ""             'clear the chosen name
 Commandlinename.text = ""     'clear the command line
End Sub
' edit the field when user leaves field
Sub CommandlineName_LostFocus ()
 Commandlinename.text = LTrim$(RTrim$(Commandlinename.text))
End Sub
'user selected DELETE from menu.  Delete the item from the
'List1 array and rewrite the FAVORITE.INI file.
Sub DeleteMenu_Click ()
 form1.width = 3915            'make form narrow
 Clear_the_fields              'clear text boxes
 If List1.listcount < 1 Or List1.listindex < 0 Then
   Beep                         'check for no items in list
   If List1.listcount < 1 Then
    response% = MsgBox("There are no items in list.", 64, "Message")
   Else
    response% = MsgBox("Click an item in the list.", 64, "Message")
   End If
 Exit Sub         'leave this sub if nothing in List1 array
 End If
 WORK% = 49 'button matrix for Msgbox
 response% = MsgBox("Delete " + LTrim$(RTrim$(Left$(List1.list(List1.listindex), 20))) + " ?", WORK%, "Warning")
 If response% = 2 Then        'user chose CANCEL button
   Exit Sub
 End If
 WORK% = List1.listindex      'item in List1 array to delete
  For I = 0 To 999            'this loop adds to array of deleted
    On Error GoTo noitem      'items this session for possible undeletes
    If Len(LTrim$(RTrim$(DELETEDITEMS(I)))) < 5 Then
      Exit For
    End If
  Next I
noitem2:
  DELETEDITEMS(I) = List1.list(List1.listindex)  'add to deleted items array
List1.RemoveItem WORK%   'remove from list1 array
MAINTSWITCH = ""
 If List1.listcount = 0 Then   'nothing in list
    On Error GoTo killerror    'delete any existing FAVORITE.INI file
 Kill "favorite.ini"
 Exit Sub
noitem:
Resume noitem2
killerror:
Resume killerror2
killerror2:
Exit Sub
Writefile              'go to routine to write the file out
End If
End Sub
Sub DosButton_Click ()
 On Error GoTo shellerror
 x = Shell("command.com", 1)
 Exit Sub
shellerror:
 Resume shellerror2
shellerror2:
response% = MsgBox("Couldn't execute COMMAND.COM. The probable problems are that COMMAND.COM is not in your path or your Window's TEMP disk is full.", 16)
End Sub
Sub form_load ()
 'VB will begin here.  Use FIRSTSWITCH as the program
 'initialization trigger.
 If FIRSTSWITCH = "" Then
    FIRSTSWITCH = "X"        'turn switch on so routine
                             'won't be used again
    form1.width = 3915
    On Error GoTo NoIniFile   'if INI file never created
                             '(VB still needs GOTO's)
    Open "favorite.ini" For Input As #1
    Close #1                 ' File exists
    ReadINIFile              'go read INI file
    Exit Sub
 Else
    Exit Sub
 End If
NoIniFile:                   'INI file doesn't exist
    Resume NoIniFile2
NoIniFile2:
End Sub
' user chose HELP from menu
Sub helpkey_click ()
 Load FORM2                'load the help form into memory
 FORM2.visible = True      'make it visible
 FORM2.helpbutton.SetFocus  'put cursor on "OK" button
End Sub
'user chose HELP key
Sub HelpMenu_Click ()
 helpkey_click
End Sub
' user single-clicked to hilight list1 item he wanted
Sub List1_Click ()
Clear_the_fields           'clear text boxes
form1.width = 3915          'make form narrow
End Sub
' DBL-clicking an item in the list causes it to run through
' WINDOW'S PROGRAM MANAGER
Sub List1_DblClick ()
If List1.listcount < 1 Then   'must be at least 1 item in list
 Beep
 Exit Sub
End If
WORK% = List1.listindex       'pointer to item in list1
'see if "Minimize on Run" box is checked, if so minimize to icon
If check1.value = 1 Then form1.windowstate = 1
'prepare SHELL instruction parameters -- program | parameters
shellitem$ = LTrim$(RTrim$(Mid$(List1.list(WORK%), 31, 50)))
shellitem$ = shellitem$ + " "
shellitem$ = shellitem$ + LTrim$(RTrim$(Right$(List1.list(WORK%), 32)))
savecaption$ = form1.caption   'save the caption & put temp one in
form1.caption = "Run " + LTrim$(Left$(List1.list(WORK%), 20))
On Error GoTo filenotfound  'in case parameters not ok
x = Shell(shellitem$, 1)  'shell to program manager
form1.caption = savecaption$
Exit Sub
filenotfound:
Resume filenotfound2
filenotfound2:       'not found dialog button
msg$ = "The program name or suffix you entered"
msg$ = msg$ + " will not call your "
msg$ = msg$ + "program from Window's Program Manager."
msg$ = msg$ + " Please  "
msg$ = msg$ + "click CHANGE to review."
response% = MsgBox(msg$, 16, LTrim$(RTrim$(Mid$(List1.list(List1.listindex), 1, 20))))
form1.caption = savecaption$
End Sub
'user passes value in TRUEFALSE variable to tell whether to
'make form's right side visible or to shrink. TRUE = make
'right side visible.  FALSE  = shrink screen to left.
Sub Make_Boxes_Visible (TRUEFALSE)
If form1.windowstate = 0 Then     'check to see that user has
                                  'not minimized form
 If TRUEFALSE = True Then
    form1.width = 8400             'wide with
 Else
    form1.width = 3915             'narrow width
 End If
End If
 PetnameLabel.visible = TRUEFALSE     'make labels, boxes and
 CommandlineLabel.visible = TRUEFALSE 'visible or invisible
 Petname.visible = TRUEFALSE
 browsebutton.visible = TRUEFALSE
 Commandlinename.visible = TRUEFALSE
 OKButton.visible = TRUEFALSE
 CancelButton.visible = TRUEFALSE
 Filenamelabel.visible = TRUEFALSE
End Sub
' user chooses "OK" after ADD or CHANGE transaction
Sub OKButton_Click ()
 add_to_list             'routine to add item to List1 array
End Sub                  'and FAVORITE.INI file
' aligns text when user leaves text box
Sub PetName_LostFocus ()
  Petname.text = LTrim$(RTrim$(Petname.text))
End Sub
'read the FAVORITE.INI file and build list1
Sub ReadINIFile ()
 Open "favorite.ini" For Input As #1
 WORK% = LOF(1)
 If WORK% < 5 Then            'test to see if null file or not
 Close #1                     'is null file
 Kill "favorite.ini"          'delete the file
 Exit Sub                     'leave, no input
 End If
 On Error GoTo EndofIniFile    'force error when end of file
 For I = 0 To 999                    'Read all possible data
 Line Input #1, INIDATA              'Read one line of file
 List1.list(I) = INIDATA             'put file record in list1
 Next I
EndofIniFile:                   'got here at end of file
Resume endofinifile2
endofinifile2:
 Close #1
End Sub
' user can undelete as many items as have been deleted this
'session by clicking on UNDELETE.  This subroutine removes them
'from the saved array and replaces them back into the List1 array
Sub UndeleteMenu_Click ()
 If Len(LTrim$(RTrim$(DELETEDITEMS(0)))) < 5 Then
    Beep          'check to see if anything saved
    response% = MsgBox("There are no items to undelete.", 64, "Message")
    Exit Sub
 End If
'pull the last deleted item from the array
'and place back into list, deleting it from the saved array
 For I = 99 To 0 Step -1
   If Len(LTrim$(RTrim$(DELETEDITEMS(I)))) > 5 Then
     List1.AddItem DELETEDITEMS(I)    'add it back to List1 array
     DELETEDITEMS(I) = ""
     Exit For
   End If
   Next I
   Writefile        'goto sub to write the FAVORITE.INI file
End Sub
'sub to write the FAVORITE.INI file after successful
'change or add transaction
Sub Writefile ()
Open "favorite.ini" For Output As #1
 On Error GoTo writeclose           'force error at end of list1 array
 WORK% = List1.listcount            'find out how many items in list1 array
 For I = 0 To WORK% - 1              'loop thru array
  INIDATA = List1.list(I)            'move to output form-global
  Print #1, INIDATA                  'write the record
 Next I
 Close #1
 Exit Sub
writeclose:                      'error trap
Resume writeclose2
writeclose2:
Close #1
End Sub